Practical 3: Web Traffic
Colin Steffe, Virany Kho, Jasmine Mawjee, Adela Sahraoui
11/25/2021
Informative Plots
Time Series
If we see a trend, the time series is not stationary (i.e. does not depend on the time of the observation).
Bar plot
Modified Series
\[ R_i = \frac{X_i - X_{i-7}}{X_{i-7}} * 100 \] \(R_i\) is the relative weekly change (increase or decrease) in percentage.
Peaks-Over-Threshold {. tabset}
Examine the suitability for each time series \(R_i\) separately:
Explain your choice of threshold and briefly comment on the diagnostic plots for each model:
- Mean Residual Plot: The following plots are used to choose the most adequate thresholds. Ideed, the value of \(u\) from which the plot becomes approximately linear can generally be selected as the optimal threshold
Elizabeth II {. tabset}
Distribution
Mean Residual Plot
The selected threshold \(u\) is 125.
Peaks-Over-Threshold Plot
United States {. tabset}
Distribution
Mean Residual Plot
The selected threshold \(u\) is 35.
Peaks-Over-Threshold Plot
Queen Victoria {. tabset}
Distribution
Mean Residual Plot
The selected threshold \(u\) is 100.
Peaks-Over-Threshold Plot
World War II {. tabset}
Distribution
Mean Residual Plot
The selected threshold \(u\) is 30.
Peaks-Over-Threshold Plot
World War I {. tabset}
Distribution
Mean Residual Plot
The selected threshold \(u\) is 25.
Peaks-Over-Threshold Plot
George VI {. tabset}
Distribution
Mean Residual Plot
The selected threshold \(u\) is 200.
Peaks-Over-Threshold Plot
United Kingdom {. tabset}
Distribution
Mean Residual Plot
The selected threshold \(u\) is 50.
Peaks-Over-Threshold Plot
Princess Margaret, Countess of Snowdon {. tabset}
Distribution
Mean Residual Plot
The selected threshold \(u\) is 700.
Peaks-Over-Threshold Plot
Prince Philip, Duke of Edinburgh {. tabset}
Distribution
Mean Residual Plot
The selected threshold \(u\) is 100.
Peaks-Over-Threshold Plot
Winston Churchill {. tabset}
Distribution
Mean Residual Plot
The selected threshold \(u\) is 100.
Peaks-Over-Threshold Plot
Diana, Princess of Wales {. tabset}
Distribution
Mean Residual Plot
The selected threshold \(u\) is 70.
Peaks-Over-Threshold Plot
2016 Summer Olympics {. tabset}
Distribution
Mean Residual Plot
The selected threshold \(u\) is 60.
Peaks-Over-Threshold Plot
Model
``
Suitability of POT: - Princess Margaret, United Kingdom, United States (?), Wiston Churchill do not seem to be suitable for POT because of the too few numbers of exceedances.
- Estimate the 99%-quantile of each series and give a corresponding measure of uncertainty = provide an interval of values within which the true value of the threshol is believed to lie with a stated probability (MSE ? with confidence interval ?)
library(evd)
# data frame for the 99 quantile and measure of uncertainty for all the type
thresholds <- c(60, 70, 125, 200, 100, 700, 100, 50, 35, 100, 25, 30)
data99 <- data.frame(matrix(0, nrow = 2, ncol = length(unique(ts$type))))
colnames(data99) <- unique(ts$type)
rownames(data99) <- c("quantile99","uncertainty")
for (i in 1:ncol(data99)){
# filter for the type
ts_type <- ts %>%
filter(type == names(data99)[i])
# remove na
ts_type <- ts_type %>%
filter(!is.na(`daily count modified`))
# compute 99 quantile
quantile99 <- quantile(ts_type$`daily count modified` , 0.99)
# save the quantile in the data.frame
data99[1,i] <- quantile99
# measure of uncertainty
# not sure about the mper argument
# doc of the function here : https://www.rdocumentation.org/packages/evd/versions/2.3-3/topics/fpot
uncertainty <- fpot(ts_type$`daily count modified`, threshold = thresholds[i], mper = quantile99)
# not sure if we need to save the r level or shape
data99[2,i] <- uncertainty$std.err[1]
}## Warning in fpot.quantile(x = x, threshold = threshold, start = start, npp =
## npp, : optimization may not have succeeded
## Warning in fpot.quantile(x = x, threshold = threshold, start = start, npp =
## npp, : optimization may not have succeeded
## Warning in fpot.quantile(x = x, threshold = threshold, start = start, npp =
## npp, : optimization may not have succeeded
## Warning in fpot.quantile(x = x, threshold = threshold, start = start, npp =
## npp, : optimization may not have succeededDetecting Simultaneous High Load
- Propose one graphical method
- Propose one numerical method
for detecting simultaneous high load across the 12 series provided, Which pages seem to have simultaneous high load?
library(extRemes)## Loading required package: Lmoments## Loading required package: distillery##
## Attaching package: 'extRemes'## The following objects are masked from 'package:evd':
##
## fbvpot, mrlplot## The following objects are masked from 'package:stats':
##
## qqnorm, qqplot# idea for graphical representation : block maxima by week colored by type
# https://rdrr.io/cran/extRemes/man/blockmaxxer.html
tsnona <- ts%>% filter(!is.na(`daily count modified`))
# compute block maxima
bm <- blockmaxxer(tsnona, blocks = tsnona$date, which="daily count modified")
library(plotly)
c <-ggplot(tsnona, aes(x=date, y=`daily count modified`)) + geom_point(aes(color = type)) + geom_point(data=bm,aes(date,`daily count modified`, fill = type), colour = "lightpink1")
ggplotly(c)# numerical method
# GDP model ?
#https://rdrr.io/cran/evir/man/gpd.html
library(evir)##
## Attaching package: 'evir'## The following object is masked from 'package:extRemes':
##
## decluster## The following objects are masked from 'package:evd':
##
## dgev, dgpd, pgev, pgpd, qgev, qgpd, rgev, rgpd## The following object is masked from 'package:ggplot2':
##
## qplotmodified_NoNA <- modified_ts %>% filter(!is.na(`daily count modified`))
gpd.model <- gpd(modified_NoNA$`daily count modified`, threshold = mean(thresholds))
gpd.plot <- tailplot(gpd.model)
#gpd.sf <- gpd.sfall(gpd.plot,0.99)library(FRAPO)## Loading required package: cccp## Loading required package: Rglpk## Loading required package: slam## Using the GLPK callable library version 4.47## Loading required package: timeSeries## Loading required package: timeDate## Financial Risk Modelling and Portfolio Optimisation with R (version 0.4-1)modified_pivot <- modified_NoNA %>% pivot_wider(values_from =`daily count modified`, names_from = type,date)
tdc(modified_pivot[,-1], method = "EVT")## 2016_Summer_Olympics
## 2016_Summer_Olympics 1.00000000
## Diana,_Princess_of_Wales 0.07142857
## Elizabeth_II 0.00000000
## George_VI 0.07142857
## Prince_Philip,_Duke_of_Edinburgh 0.03571429
## Princess_Margaret,_Countess_of_Snowdon 0.10714286
## Queen_Victoria 0.03571429
## United_Kingdom 0.10714286
## United_States 0.21428571
## Winston_Churchill 0.03571429
## World_War_I 0.00000000
## World_War_II 0.03571429
## Diana,_Princess_of_Wales Elizabeth_II
## 2016_Summer_Olympics 0.07142857 0.00000000
## Diana,_Princess_of_Wales 1.00000000 0.07142857
## Elizabeth_II 0.07142857 1.00000000
## George_VI 0.07142857 0.46428571
## Prince_Philip,_Duke_of_Edinburgh 0.14285714 0.60714286
## Princess_Margaret,_Countess_of_Snowdon 0.07142857 0.46428571
## Queen_Victoria 0.07142857 0.28571429
## United_Kingdom 0.03571429 0.10714286
## United_States 0.03571429 0.00000000
## Winston_Churchill 0.00000000 0.03571429
## World_War_I 0.00000000 0.14285714
## World_War_II 0.03571429 0.00000000
## George_VI
## 2016_Summer_Olympics 0.07142857
## Diana,_Princess_of_Wales 0.07142857
## Elizabeth_II 0.46428571
## George_VI 1.00000000
## Prince_Philip,_Duke_of_Edinburgh 0.53571429
## Princess_Margaret,_Countess_of_Snowdon 0.57142857
## Queen_Victoria 0.32142857
## United_Kingdom 0.07142857
## United_States 0.03571429
## Winston_Churchill 0.07142857
## World_War_I 0.10714286
## World_War_II 0.03571429
## Prince_Philip,_Duke_of_Edinburgh
## 2016_Summer_Olympics 0.03571429
## Diana,_Princess_of_Wales 0.14285714
## Elizabeth_II 0.60714286
## George_VI 0.53571429
## Prince_Philip,_Duke_of_Edinburgh 1.00000000
## Princess_Margaret,_Countess_of_Snowdon 0.53571429
## Queen_Victoria 0.21428571
## United_Kingdom 0.07142857
## United_States 0.00000000
## Winston_Churchill 0.03571429
## World_War_I 0.10714286
## World_War_II 0.03571429
## Princess_Margaret,_Countess_of_Snowdon
## 2016_Summer_Olympics 0.10714286
## Diana,_Princess_of_Wales 0.07142857
## Elizabeth_II 0.46428571
## George_VI 0.57142857
## Prince_Philip,_Duke_of_Edinburgh 0.53571429
## Princess_Margaret,_Countess_of_Snowdon 1.00000000
## Queen_Victoria 0.21428571
## United_Kingdom 0.07142857
## United_States 0.07142857
## Winston_Churchill 0.00000000
## World_War_I 0.10714286
## World_War_II 0.03571429
## Queen_Victoria United_Kingdom
## 2016_Summer_Olympics 0.03571429 0.10714286
## Diana,_Princess_of_Wales 0.07142857 0.03571429
## Elizabeth_II 0.28571429 0.10714286
## George_VI 0.32142857 0.07142857
## Prince_Philip,_Duke_of_Edinburgh 0.21428571 0.07142857
## Princess_Margaret,_Countess_of_Snowdon 0.21428571 0.07142857
## Queen_Victoria 1.00000000 0.03571429
## United_Kingdom 0.03571429 1.00000000
## United_States 0.00000000 0.03571429
## Winston_Churchill 0.00000000 0.17857143
## World_War_I 0.10714286 0.10714286
## World_War_II 0.00000000 0.10714286
## United_States Winston_Churchill
## 2016_Summer_Olympics 0.21428571 0.03571429
## Diana,_Princess_of_Wales 0.03571429 0.00000000
## Elizabeth_II 0.00000000 0.03571429
## George_VI 0.03571429 0.07142857
## Prince_Philip,_Duke_of_Edinburgh 0.00000000 0.03571429
## Princess_Margaret,_Countess_of_Snowdon 0.07142857 0.00000000
## Queen_Victoria 0.00000000 0.00000000
## United_Kingdom 0.03571429 0.17857143
## United_States 1.00000000 0.07142857
## Winston_Churchill 0.07142857 1.00000000
## World_War_I 0.17857143 0.10714286
## World_War_II 0.17857143 0.07142857
## World_War_I World_War_II
## 2016_Summer_Olympics 0.0000000 0.03571429
## Diana,_Princess_of_Wales 0.0000000 0.03571429
## Elizabeth_II 0.1428571 0.00000000
## George_VI 0.1071429 0.03571429
## Prince_Philip,_Duke_of_Edinburgh 0.1071429 0.03571429
## Princess_Margaret,_Countess_of_Snowdon 0.1071429 0.03571429
## Queen_Victoria 0.1071429 0.00000000
## United_Kingdom 0.1071429 0.10714286
## United_States 0.1785714 0.17857143
## Winston_Churchill 0.1071429 0.07142857
## World_War_I 1.0000000 0.42857143
## World_War_II 0.4285714 1.00000000